home *** CD-ROM | disk | FTP | other *** search
/ Developer CD Series 1996 May: Tool Chest / Developer CD Series May 1996 (Tool Chest) (Apple Computer) (1996).iso / Tool Chest / Development Tools & Languages / Macintosh Common Lisp Related / User Contributions / Misc.sea / Misc / passwords.lisp < prev    next >
Encoding:
Text File  |  1993-02-26  |  4.7 KB  |  114 lines  |  [TEXT/CCL2]
  1. (in-package "CCL")
  2.  
  3. (export '(password-text-dialog-item))
  4.  
  5.  
  6. ;; The definition of a class of editable-text-dialog-item that doesn't
  7. ;; echo the characters entered. Denis R Howlett <drh@world.std.com>
  8.  
  9.  
  10. (defclass password-text-dialog-item (editable-text-dialog-item)
  11.   ;; the password-text-dialog-item has two extra attributes:
  12.   ;; - the alter-ego is a regular editable-text-dialog-item which holds
  13.   ;;   the true text
  14.   ;; - the echo-char holds the character to be used for echoing. The
  15.   ;;   default is the bullet character.
  16.   ((alter-ego :initform nil 
  17.               :initarg :alter-ego
  18.               :accessor password-text-alter-ego)
  19.    (echo-char :initform #\245
  20.               :initarg :echo-char
  21.               :accessor password-text-echo-char)))
  22.  
  23. (defmethod initialize-instance ((item password-text-dialog-item) &rest args)
  24.   ;; this method creates a regular editable-text-dialog-item 
  25.   ;; and stores it in the alter-ego slot.
  26.   (declare (ignore args))
  27.   (setf (password-text-alter-ego item)
  28.         (make-instance 'editable-text-dialog-item))
  29.   (call-next-method))
  30.   
  31. (defmethod keystroke-function :before ((item password-text-dialog-item) 
  32.                                        keystroke &optional comtab)
  33.   ;; this is the clever bit!
  34.   ;; whenever a keystroke is received for the password-text-dialog-item
  35.   ;; it is sent to the alter-ego editable-text-dialog-item and then the
  36.   ;; current-keystroke and current-character are changed to be the echo
  37.   ;; character before proceeding. This has the result that the alter-ego
  38.   ;; dialog-item has the correct text and the visible dialog-item has 
  39.   ;; just the echo characters.
  40.  
  41.   ;; Note: there are problems with complicated keystrokes like meta-y
  42.   ;; but I don't suppose anybody really wants meta-y in a password...
  43.   ;; it may be because I set *current-keystroke* regardless of whether 
  44.   ;; this is a self insert character or not...
  45.  
  46.   (declare (ignore comtab))
  47.   (let* ((alter-ego (password-text-alter-ego item))
  48.          (echo-char (password-text-echo-char item))
  49.          (func (keystroke-function alter-ego keystroke)))
  50.     (apply func (list alter-ego))
  51.     (setf *current-keystroke* echo-char)
  52.     (setf *current-character* echo-char)))
  53.  
  54. (defmethod view-click-event-handler :after ((item password-text-dialog-item) 
  55.                                             where)
  56.  
  57.   ;; To handle the mouse, we have to see if the user has marked a region
  58.   ;; or moved the insertion point. Fortunately, the functions 
  59.   ;; selection-range and set-selection-range do both for us, so, whenever
  60.   ;; the user uses the mouse, update the selection range and cursor 
  61.   ;; position. This ensures that the user can delete a whole range etc.
  62.  
  63.   (declare (ignore where))
  64.   (let ((alter-ego (password-text-alter-ego item)))
  65.     (multiple-value-bind (position cursorpos)
  66.                          (selection-range item)
  67.       (set-selection-range alter-ego position cursorpos))))
  68.  
  69. (defmethod dialog-item-text ((item password-text-dialog-item))
  70.  
  71.   ;; this allows transparent access to the text - call this just
  72.   ;; like for any dialog item, but it returns the correct text
  73.   ;; from the alter-ego.
  74.   (dialog-item-text (password-text-alter-ego item)))
  75.  
  76.  
  77. #|
  78. (defun get-password ()
  79.   ;; This is a simple example of the use of the password-text-dialog-item
  80.  
  81.   (let ((win (make-instance 'dialog
  82.                             :window-type :double-edge-box 
  83.                             :view-position :centered
  84.                             :view-size #@(200 100)
  85.                             :close-box-p nil
  86.                             :view-font '("Chicago" 12 :SRCOR :PLAIN)))
  87.         (password (make-dialog-item 'password-text-dialog-item
  88.                                        #@(20 44)
  89.                                        #@(133 16)
  90.                                        ""
  91.                                        nil
  92.                                        :allow-returns nil)))
  93.  
  94.     (add-subviews win
  95.                   (make-dialog-item 'static-text-dialog-item
  96.                                     #@(16 14)
  97.                                     #@(141 16)
  98.                                     "Enter the password:"
  99.                                     nil)
  100.                   password
  101.                   (make-dialog-item 'button-dialog-item
  102.                                     #@(91 81)
  103.                                     #@(62 16)
  104.                                     "OK"
  105.                                     #'(lambda
  106.                                         (item)
  107.                                         item
  108.                                         (return-from-modal-dialog
  109.                                          (dialog-item-text password)))
  110.                                     :default-button t))
  111.     
  112.     (modal-dialog win)))
  113. |#
  114.